home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2002 November / CD 1 / APC0211D1.ISO / workshop / prog / files / ActivePerl-5.6.1.633-MSWin32.msi / _3cc1e3c1c200c47c917ca4166ed3dd4e < prev    next >
Encoding:
Text File  |  2002-05-01  |  11.5 KB  |  413 lines
  1. package HTML::Entities;
  2.  
  3. # $Id: Entities.pm,v 1.23 2001/11/05 21:23:21 gisle Exp $
  4.  
  5. =head1 NAME
  6.  
  7. HTML::Entities - Encode or decode strings with HTML entities
  8.  
  9. =head1 SYNOPSIS
  10.  
  11.  use HTML::Entities;
  12.  
  13.  $a = "Våre norske tegn bør æres";
  14.  decode_entities($a);
  15.  encode_entities($a, "\200-\377");
  16.  
  17. =head1 DESCRIPTION
  18.  
  19. This module deals with encoding and decoding of strings with HTML
  20. character entities.  The module provides the following functions:
  21.  
  22. =over 4
  23.  
  24. =item decode_entities($string)
  25.  
  26. This routine replaces HTML entities found in the $string with the
  27. corresponding ISO-8859/1 (or with perl-5.7 or better Unicode)
  28. character.  Unrecognized entities are left alone.
  29.  
  30. =item encode_entities($string, [$unsafe_chars])
  31.  
  32. This routine replaces unsafe characters in $string with their entity
  33. representation.  A second argument can be given to specify which
  34. characters to concider as unsafe.  The default set of characters to
  35. expand are control chars, high-bit chars and the '<', '&', '>' and '"'
  36. characters.
  37.  
  38. =back
  39.  
  40. Both routines modify the string passed as the first argument if
  41. called in a void context.  In scalar and array contexts the encoded or
  42. decoded string is returned (and the argument string is left
  43. unchanged).
  44.  
  45. If you prefer not to import these routines into your namespace you can
  46. call them as:
  47.  
  48.   use HTML::Entities ();
  49.   $encoded = HTML::Entities::encode($a);
  50.   $decoded = HTML::Entities::decode($a);
  51.  
  52. The module can also export the %char2entity and the %entity2char
  53. hashes which contain the mapping from all characters to the
  54. corresponding entities.
  55.  
  56. =head1 COPYRIGHT
  57.  
  58. Copyright 1995-2001 Gisle Aas. All rights reserved.
  59.  
  60. This library is free software; you can redistribute it and/or
  61. modify it under the same terms as Perl itself.
  62.  
  63. =cut
  64.  
  65. use strict;
  66. use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
  67. use vars qw(%entity2char %char2entity);
  68.  
  69. require 5.004;
  70. require Exporter;
  71. @ISA = qw(Exporter);
  72.  
  73. @EXPORT = qw(encode_entities decode_entities _decode_entities);
  74. @EXPORT_OK = qw(%entity2char %char2entity);
  75.  
  76. $VERSION = sprintf("%d.%02d", q$Revision: 1.23 $ =~ /(\d+)\.(\d+)/);
  77. sub Version { $VERSION; }
  78.  
  79. require HTML::Parser;  # for fast XS implemented decode_entities
  80.  
  81.  
  82. %entity2char = (
  83.  # Some normal chars that have special meaning in SGML context
  84.  amp    => '&',  # ampersand 
  85. 'gt'    => '>',  # greater than
  86. 'lt'    => '<',  # less than
  87.  quot   => '"',  # double quote
  88.  apos   => "'",  # single quote
  89.  
  90.  # PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML
  91.  AElig    => '╞',  # capital AE diphthong (ligature)
  92.  Aacute    => '┴',  # capital A, acute accent
  93.  Acirc    => '┬',  # capital A, circumflex accent
  94.  Agrave    => '└',  # capital A, grave accent
  95.  Aring    => '┼',  # capital A, ring
  96.  Atilde    => '├',  # capital A, tilde
  97.  Auml    => '─',  # capital A, dieresis or umlaut mark
  98.  Ccedil    => '╟',  # capital C, cedilla
  99.  ETH    => '╨',  # capital Eth, Icelandic
  100.  Eacute    => '╔',  # capital E, acute accent
  101.  Ecirc    => '╩',  # capital E, circumflex accent
  102.  Egrave    => '╚',  # capital E, grave accent
  103.  Euml    => '╦',  # capital E, dieresis or umlaut mark
  104.  Iacute    => '═',  # capital I, acute accent
  105.  Icirc    => '╬',  # capital I, circumflex accent
  106.  Igrave    => '╠',  # capital I, grave accent
  107.  Iuml    => '╧',  # capital I, dieresis or umlaut mark
  108.  Ntilde    => '╤',  # capital N, tilde
  109.  Oacute    => '╙',  # capital O, acute accent
  110.  Ocirc    => '╘',  # capital O, circumflex accent
  111.  Ograve    => '╥',  # capital O, grave accent
  112.  Oslash    => '╪',  # capital O, slash
  113.  Otilde    => '╒',  # capital O, tilde
  114.  Ouml    => '╓',  # capital O, dieresis or umlaut mark
  115.  THORN    => '▐',  # capital THORN, Icelandic
  116.  Uacute    => '┌',  # capital U, acute accent
  117.  Ucirc    => '█',  # capital U, circumflex accent
  118.  Ugrave    => '┘',  # capital U, grave accent
  119.  Uuml    => '▄',  # capital U, dieresis or umlaut mark
  120.  Yacute    => '▌',  # capital Y, acute accent
  121.  aacute    => 'ß',  # small a, acute accent
  122.  acirc    => 'Γ',  # small a, circumflex accent
  123.  aelig    => 'µ',  # small ae diphthong (ligature)
  124.  agrave    => 'α',  # small a, grave accent
  125.  aring    => 'σ',  # small a, ring
  126.  atilde    => 'π',  # small a, tilde
  127.  auml    => 'Σ',  # small a, dieresis or umlaut mark
  128.  ccedil    => 'τ',  # small c, cedilla
  129.  eacute    => 'Θ',  # small e, acute accent
  130.  ecirc    => 'Ω',  # small e, circumflex accent
  131.  egrave    => 'Φ',  # small e, grave accent
  132.  eth    => '≡',  # small eth, Icelandic
  133.  euml    => 'δ',  # small e, dieresis or umlaut mark
  134.  iacute    => 'φ',  # small i, acute accent
  135.  icirc    => 'ε',  # small i, circumflex accent
  136.  igrave    => '∞',  # small i, grave accent
  137.  iuml    => '∩',  # small i, dieresis or umlaut mark
  138.  ntilde    => '±',  # small n, tilde
  139.  oacute    => '≤',  # small o, acute accent
  140.  ocirc    => '⌠',  # small o, circumflex accent
  141.  ograve    => '≥',  # small o, grave accent
  142.  oslash    => '°',  # small o, slash
  143.  otilde    => '⌡',  # small o, tilde
  144.  ouml    => '÷',  # small o, dieresis or umlaut mark
  145.  szlig    => '▀',  # small sharp s, German (sz ligature)
  146.  thorn    => '■',  # small thorn, Icelandic
  147.  uacute    => '·',  # small u, acute accent
  148.  ucirc    => '√',  # small u, circumflex accent
  149.  ugrave    => '∙',  # small u, grave accent
  150.  uuml    => 'ⁿ',  # small u, dieresis or umlaut mark
  151.  yacute    => '²',  # small y, acute accent
  152.  yuml    => ' ',  # small y, dieresis or umlaut mark
  153.  
  154.  # Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96)
  155.  copy   => '⌐',  # copyright sign
  156.  reg    => '«',  # registered sign
  157.  nbsp   => "\240", # non breaking space
  158.  
  159.  # Additional ISO-8859/1 entities listed in rfc1866 (section 14)
  160.  iexcl  => 'í',
  161.  cent   => 'ó',
  162.  pound  => 'ú',
  163.  curren => 'ñ',
  164.  yen    => 'Ñ',
  165.  brvbar => 'ª',
  166.  sect   => 'º',
  167.  uml    => '¿',
  168.  ordf   => '¬',
  169.  laquo  => '½',
  170. 'not'   => '¼',    # not is a keyword in perl
  171.  shy    => '¡',
  172.  macr   => '»',
  173.  deg    => '░',
  174.  plusmn => '▒',
  175.  sup1   => '╣',
  176.  sup2   => '▓',
  177.  sup3   => '│',
  178.  acute  => '┤',
  179.  micro  => '╡',
  180.  para   => '╢',
  181.  middot => '╖',
  182.  cedil  => '╕',
  183.  ordm   => '║',
  184.  raquo  => '╗',
  185.  frac14 => '╝',
  186.  frac12 => '╜',
  187.  frac34 => '╛',
  188.  iquest => '┐',
  189. 'times' => '╫',    # times is a keyword in perl
  190.  divide => '≈',
  191.  
  192.  ( $] > 5.007 ? (
  193.    OElig    => chr(338),
  194.    oelig    => chr(339),
  195.    Scaron   => chr(352),
  196.    scaron   => chr(353),
  197.    Yuml     => chr(376),
  198.    fnof     => chr(402),
  199.    circ     => chr(710),
  200.    tilde    => chr(732),
  201.    Alpha    => chr(913),
  202.    Beta     => chr(914),
  203.    Gamma    => chr(915),
  204.    Delta    => chr(916),
  205.    Epsilon  => chr(917),
  206.    Zeta     => chr(918),
  207.    Eta      => chr(919),
  208.    Theta    => chr(920),
  209.    Iota     => chr(921),
  210.    Kappa    => chr(922),
  211.    Lambda   => chr(923),
  212.    Mu       => chr(924),
  213.    Nu       => chr(925),
  214.    Xi       => chr(926),
  215.    Omicron  => chr(927),
  216.    Pi       => chr(928),
  217.    Rho      => chr(929),
  218.    Sigma    => chr(931),
  219.    Tau      => chr(932),
  220.    Upsilon  => chr(933),
  221.    Phi      => chr(934),
  222.    Chi      => chr(935),
  223.    Psi      => chr(936),
  224.    Omega    => chr(937),
  225.    alpha    => chr(945),
  226.    beta     => chr(946),
  227.    gamma    => chr(947),
  228.    delta    => chr(948),
  229.    epsilon  => chr(949),
  230.    zeta     => chr(950),
  231.    eta      => chr(951),
  232.    theta    => chr(952),
  233.    iota     => chr(953),
  234.    kappa    => chr(954),
  235.    lambda   => chr(955),
  236.    mu       => chr(956),
  237.    nu       => chr(957),
  238.    xi       => chr(958),
  239.    omicron  => chr(959),
  240.    pi       => chr(960),
  241.    rho      => chr(961),
  242.    sigmaf   => chr(962),
  243.    sigma    => chr(963),
  244.    tau      => chr(964),
  245.    upsilon  => chr(965),
  246.    phi      => chr(966),
  247.    chi      => chr(967),
  248.    psi      => chr(968),
  249.    omega    => chr(969),
  250.    thetasym => chr(977),
  251.    upsih    => chr(978),
  252.    piv      => chr(982),
  253.    ensp     => chr(8194),
  254.    emsp     => chr(8195),
  255.    thinsp   => chr(8201),
  256.    zwnj     => chr(8204),
  257.    zwj      => chr(8205),
  258.    lrm      => chr(8206),
  259.    rlm      => chr(8207),
  260.    ndash    => chr(8211),
  261.    mdash    => chr(8212),
  262.    lsquo    => chr(8216),
  263.    rsquo    => chr(8217),
  264.    sbquo    => chr(8218),
  265.    ldquo    => chr(8220),
  266.    rdquo    => chr(8221),
  267.    bdquo    => chr(8222),
  268.    dagger   => chr(8224),
  269.    Dagger   => chr(8225),
  270.    bull     => chr(8226),
  271.    hellip   => chr(8230),
  272.    permil   => chr(8240),
  273.    prime    => chr(8242),
  274.    Prime    => chr(8243),
  275.    lsaquo   => chr(8249),
  276.    rsaquo   => chr(8250),
  277.    oline    => chr(8254),
  278.    frasl    => chr(8260),
  279.    euro     => chr(8364),
  280.    image    => chr(8465),
  281.    weierp   => chr(8472),
  282.    real     => chr(8476),
  283.    trade    => chr(8482),
  284.    alefsym  => chr(8501),
  285.    larr     => chr(8592),
  286.    uarr     => chr(8593),
  287.    rarr     => chr(8594),
  288.    darr     => chr(8595),
  289.    harr     => chr(8596),
  290.    crarr    => chr(8629),
  291.    lArr     => chr(8656),
  292.    uArr     => chr(8657),
  293.    rArr     => chr(8658),
  294.    dArr     => chr(8659),
  295.    hArr     => chr(8660),
  296.    forall   => chr(8704),
  297.    part     => chr(8706),
  298.    exist    => chr(8707),
  299.    empty    => chr(8709),
  300.    nabla    => chr(8711),
  301.    isin     => chr(8712),
  302.    notin    => chr(8713),
  303.    ni       => chr(8715),
  304.    prod     => chr(8719),
  305.    sum      => chr(8721),
  306.    minus    => chr(8722),
  307.    lowast   => chr(8727),
  308.    radic    => chr(8730),
  309.    prop     => chr(8733),
  310.    infin    => chr(8734),
  311.    ang      => chr(8736),
  312.   'and'     => chr(8743),
  313.   'or'      => chr(8744),
  314.    cap      => chr(8745),
  315.    cup      => chr(8746),
  316.   'int'     => chr(8747),
  317.    there4   => chr(8756),
  318.    sim      => chr(8764),
  319.    cong     => chr(8773),
  320.    asymp    => chr(8776),
  321.   'ne'      => chr(8800),
  322.    equiv    => chr(8801),
  323.   'le'      => chr(8804),
  324.   'ge'      => chr(8805),
  325.   'sub'     => chr(8834),
  326.    sup      => chr(8835),
  327.    nsub     => chr(8836),
  328.    sube     => chr(8838),
  329.    supe     => chr(8839),
  330.    oplus    => chr(8853),
  331.    otimes   => chr(8855),
  332.    perp     => chr(8869),
  333.    sdot     => chr(8901),
  334.    lceil    => chr(8968),
  335.    rceil    => chr(8969),
  336.    lfloor   => chr(8970),
  337.    rfloor   => chr(8971),
  338.    lang     => chr(9001),
  339.    rang     => chr(9002),
  340.    loz      => chr(9674),
  341.    spades   => chr(9824),
  342.    clubs    => chr(9827),
  343.    hearts   => chr(9829),
  344.    diams    => chr(9830),
  345.  ) : ())
  346. );
  347.  
  348.  
  349. # Make the oposite mapping
  350. while (my($entity, $char) = each(%entity2char)) {
  351.     $char2entity{$char} = "&$entity;";
  352. }
  353. delete $char2entity{"'"};  # only one-way decoding
  354.  
  355. # Fill inn missing entities
  356. for (0 .. 255) {
  357.     next if exists $char2entity{chr($_)};
  358.     $char2entity{chr($_)} = "&#$_;";
  359. }
  360.  
  361. my %subst;  # compiled encoding regexps
  362.  
  363. sub decode_entities_old
  364. {
  365.     my $array;
  366.     if (defined wantarray) {
  367.     $array = [@_]; # copy
  368.     } else {
  369.     $array = \@_;  # modify in-place
  370.     }
  371.     my $c;
  372.     for (@$array) {
  373.     s/(&\#(\d+);?)/$2 < 256 ? chr($2) : $1/eg;
  374.     s/(&\#[xX]([0-9a-fA-F]+);?)/$c = hex($2); $c < 256 ? chr($c) : $1/eg;
  375.     s/(&(\w+);?)/$entity2char{$2} || $1/eg;
  376.     }
  377.     wantarray ? @$array : $array->[0];
  378. }
  379.  
  380. sub encode_entities
  381. {
  382.     my $ref;
  383.     if (defined wantarray) {
  384.     my $x = $_[0];
  385.     $ref = \$x;     # copy
  386.     } else {
  387.     $ref = \$_[0];  # modify in-place
  388.     }
  389.     if (defined $_[1]) {
  390.     unless (exists $subst{$_[1]}) {
  391.         # Because we can't compile regex we fake it with a cached sub
  392.         $subst{$_[1]} =
  393.           eval "sub {\$_[0] =~ s/([$_[1]])/\$char2entity{\$1} || num_entity(\$1)/ge; }";
  394.         die $@ if $@;
  395.     }
  396.     &{$subst{$_[1]}}($$ref);
  397.     } else {
  398.     # Encode control chars, high bit chars and '<', '&', '>', '"'
  399.     $$ref =~ s/([^\n\r\t !\#\$%\'-;=?-~])/$char2entity{$1} || num_entity($1)/ge;
  400.     }
  401.     $$ref;
  402. }
  403.  
  404. sub num_entity {
  405.     sprintf "&#x%X;", ord($_[0]);
  406. }
  407.  
  408. # Set up aliases
  409. *encode = \&encode_entities;
  410. *decode = \&decode_entities;
  411.  
  412. 1;
  413.